(import (except (rnrs base) error)
        (only (guile)
              lambda* λ
              ;; string formatting
              simple-format)
        ;; exceptions
        (ice-9 exceptions)
        (custom-exceptions)
        ;; Import and assign a prefix to distinguish the
        ;; implementations.
        (prefix (rectangular) rect:)
        (prefix (polar) polar:)
        (tagged-data)
        ;; hash-tables
        (srfi srfi-69))

;;; LOOKUP TABLE -- DATA-DIRECTED PROGRAMMING

(define op-lookup-table
  (make-hash-table eq?))


(define get-op
  (λ (op type-tag)
    (let ([key (list op type-tag)])
      (hash-table-ref/default op-lookup-table
                              key
                              (λ ()
                                (raise-exception
                                 (make-exception
                                  (make-lookup-error key)
                                  (make-exception-with-message
                                   "key not found in op-lookup-table")
                                  (make-exception-with-irritants (list key))
                                  (make-exception-with-origin 'get-op))))))))


(define set-op!
  (λ (op type-tag proc)
    (hash-table-set! op-lookup-table
                     (list op type-tag)
                     proc)))

;;; GENERIC SELECTORS

;;; Generic selectors check the type tag of data and decide which
;;; procedure to use for that data based on the type tag. They are
;;; implemented on top of specific procedures.

;;; The selectors make use of dispatching on type. They check the
;;; type and act according to the type.

(define real-part
  (λ (datum)
    (simple-format #t "real-part in solution, datum: ~a\n" datum)
    (cond
     ;; dispatch on type
     [(rect:rectangular? datum)
      (simple-format #t "real-part in solution, datum is rectangular?: ~a\n" (rect:rectangular? datum))
      (rect:real-part (contents datum))]
     [(polar:polar? datum)
      (simple-format #t "real-part in solution, datum is polar?: ~a\n" (polar:polar? datum))
      (polar:real-part (contents datum))]
     [else
      (raise-exception
       (make-exception
        (make-inappropriate-value-exception datum)
        (make-exception-with-message "datum has unrecognized type tag")
        (make-exception-with-irritants (list datum))
        (make-exception-with-origin 'real-part)))])))

(define imag-part
  (λ (datum)
    (cond
     ;; dispatch on type
     [(rect:rectangular? datum)
      (rect:imag-part (contents datum))]
     [(polar:polar? datum)
      (polar:imag-part (contents datum))]
     [else
      (raise-exception
       (make-exception
        (make-inappropriate-value-exception datum)
        (make-exception-with-message "datum has unrecognized type tag")
        (make-exception-with-irritants (list datum))
        (make-exception-with-origin 'imag-part)))])))

(define magnitude
  (λ (datum)
    (cond
     ;; dispatch on type
     [(rect:rectangular? datum)
      (rect:magnitude (contents datum))]
     [(polar:polar? datum)
      (polar:magnitude (contents datum))]
     [else
      (raise-exception
       (make-exception
        (make-inappropriate-value-exception datum)
        (make-exception-with-message "datum has unrecognized type tag")
        (make-exception-with-irritants (list datum))
        (make-exception-with-origin 'magnitude)))])))

(define angle
  (λ (datum)
    ;; dispatch on type
    (cond
     [(rect:rectangular? datum)
      (rect:angle (contents datum))]
     [(polar:polar? datum)
      (polar:angle (contents datum))]
     [else
      (raise-exception
       (make-exception
        (make-inappropriate-value-exception datum)
        (make-exception-with-message "datum has unrecognized type tag")
        (make-exception-with-irritants (list datum))
        (make-exception-with-origin 'angle)))])))

  ;;; GENERIC CONSTRUCTORS

  ;;; Whenever we have real and imaginary part, we use rectangular
  ;;; form, since it does not require us to translate to magnitude and
  ;;; angle. Whenever we have magnitude and angle, we use polar form,
  ;;; because it does not require us to translate to real and
  ;;; imaginary part.

(define make-from-real-imag
  (λ (real imag)
    (rect:make-from-real-imag real imag)))

(define make-from-mag-ang
  (λ (mag ang)
    (polar:make-from-mag-ang mag ang)))

  ;;; The generic part of the solution only contains operations
  ;;; defined on top of accessors / selectors. It depends on which
  ;;; library is imported, the rectangular form implementing one, or
  ;;; the polar form implementing one.

(define add-complex
  (λ (num1 num2)
    (make-from-real-imag (+ (real-part num1) (real-part num2))
                         (+ (imag-part num1) (imag-part num2)))))

(define sub-complex
  (λ (num1 num2)
    (make-from-real-imag (- (real-part num1) (real-part num2))
                         (- (imag-part num1) (imag-part num2)))))

(define mul-complex
  (λ (num1 num2)
    (make-from-mag-ang (* (magnitude num1) (magnitude num2))
                       (+ (angle num1) (angle num2)))))

(define div-complex
  (λ (num1 num2)
    (make-from-mag-ang (/ (magnitude num1) (magnitude num2))
                       (- (angle num1) (angle num2)))))


;; ;; try some expressions
;; (simple-format
;;  #t "~a\n"
;;  (add-complex (make-from-real-imag 2 3) (make-from-real-imag 4 5)))
